dpp.SendTo .lDPlayID, oBuf, 0, DPNSEND_NOLOOPBACK Or DPNSEND_GUARANTEED
.lCurrentPos = .lCurrentPos + lChunkSize
'Update our transfer window
.SetValue .lCurrentPos
If .lCurrentPos >= .lFileSize Then
Close #.filNumber
'Now get rid of this member of the array
EraseSendFile .FileUniqueID
End If
End With
UnlockSendCollection
End Sub
Public Sub EraseSendFile(ByVal lUnique As Long)
Dim lCount As Long, f As frmProgress
'First we need to find the correct file in our send list
LockSendCollection
For lCount = moSendFiles.Count To 1 Step -1
Set f = moSendFiles.Item(lCount)
If f.FileUniqueID = lUnique Then
moSendFiles.Remove lCount
Unload f
Set f = Nothing
Exit For
End If
Next
UnlockSendCollection
End Sub
Public Sub EraseReceiveFile(ByVal lUnique As Long)
Dim lCount As Long, f As frmProgress
'First we need to find the correct file in our send list
LockReceiveCollection
For lCount = moReceivedFiles.Count To 1 Step -1
Set f = moReceivedFiles.Item(lCount)
If f.FileUniqueID = lUnique Then
moReceivedFiles.Remove lCount
Unload f.RequestForm
Set f.RequestForm = Nothing
Unload f
Set f = Nothing
Exit For
End If
Next
UnlockReceiveCollection
End Sub
Private Function GetSendProgressForm(ByVal lUnique As Long) As frmProgress
Dim f As frmProgress
LockSendCollection
For Each f In moSendFiles
If f.FileUniqueID = lUnique Then
Set GetSendProgressForm = f
Exit For
End If
Next
UnlockSendCollection
End Function
Private Function GetReceiveProgressForm(ByVal lUnique As Long) As frmProgress
Dim f As frmProgress
LockReceiveCollection
For Each f In moReceivedFiles
If f.FileUniqueID = lUnique Then
Set GetReceiveProgressForm = f
Exit For
End If
Next
UnlockReceiveCollection
End Function
Private Function GetFolder(ByVal sFile As String) As String
Dim lCount As Long
For lCount = Len(sFile) To 1 Step -1
If Mid$(sFile, lCount, 1) = "\" Then
GetFolder = Left$(sFile, lCount)
Exit Function
End If
Next
GetFolder = vbNullString
End Function
Private Sub tmrUpdate_Timer()
tmrUpdate.Enabled = False
If Not mfTerminate Then
MsgBox "The person you are trying to reach is not available.", vbOKOnly Or vbInformation, "Unavailable"
End If
StartHosting Me
mfTerminate = False
End Sub
Private Sub tmrVoice_Timer()
tmrVoice.Enabled = False
MsgBox "Could not start DirectPlayVoice. This sample will not have any voice capablities." & vbCrLf & "Error:" & CStr(mlVoiceError), vbOKOnly Or vbInformation, "No Voice"
gfNoVoice = True
chkVoice.Value = vbUnchecked
chkVoice.Enabled = False
End Sub
'We will hold a critical section for the two separate collections
'This will ensure that two threads can't access the data at the same time
Public Sub LockSendCollection()
EnterCriticalSection goSendFile
End Sub
Public Sub UnlockSendCollection()
LeaveCriticalSection goSendFile
End Sub
Public Sub LockReceiveCollection()
EnterCriticalSection goReceiveFile
End Sub
Public Sub UnlockReceiveCollection()
LeaveCriticalSection goReceiveFile
End Sub
'We will handle all of the msgs here, and report them all back to the callback sub
'in case the caller cares what's going on
Private Sub DirectPlay8Event_AddRemovePlayerGroup(ByVal lMsgID As Long, ByVal lPlayerID As Long, ByVal lGroupID As Long, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallBack Is Nothing) Then moCallBack.AddRemovePlayerGroup lMsgID, lPlayerID, lGroupID, fRejectMsg
End Sub
Private Sub DirectPlay8Event_AppDesc(fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallBack Is Nothing) Then moCallBack.AppDesc fRejectMsg
End Sub
Private Sub DirectPlay8Event_AsyncOpComplete(dpnotify As DxVBLibA.DPNMSG_ASYNC_OP_COMPLETE, fRejectMsg As Boolean)
'VB requires that we must implement *every* member of this interface
If (Not moCallBack Is Nothing) Then moCallBack.AsyncOpComplete dpnotify, fRejectMsg
End Sub
Private Sub DirectPlay8Event_ConnectComplete(dpnotify As DxVBLibA.DPNMSG_CONNECT_COMPLETE, fRejectMsg As Boolean)
Dim lMsg As Long, lOffset As Long
Dim oBuf() As Byte
If dpnotify.hResultCode = 0 Then 'Success!
cmdHangup.Enabled = True
'Now let's send a message asking the host to accept our call
